home *** CD-ROM | disk | FTP | other *** search
/ JCSM Shareware Collection 1996 September / JCSM Shareware Collection (JCS Distribution) (September 1996).ISO / prgtools / wformpas.zip / test.old < prev    next >
Text File  |  1994-04-04  |  4KB  |  150 lines
  1. {programm    : wbild.pas
  2.  Funktion    : Anzeige der bildwiederholungsfrequenz unter Windows
  3.  Autor       : Wilfried Lottermoser
  4. }
  5.  
  6. program wbild;
  7. Uses owindows,wintypes,winprocs,strings,windos;
  8. Type
  9. TMyApplication = object(tapplication)
  10. Procedure initmainwindow; virtual;
  11. Function processappmsg(var message:tmsg):boolean;virtual;
  12. End;
  13.  
  14. PFenster = ^TFenster;
  15. Tfenster = object (twindow)
  16. WDC:HDC;
  17. gett:real;
  18. f:array[0..9] of real;
  19. Count:byte;
  20. busy:boolean;
  21. xres,yres:string;
  22. Constructor init (Mutterfenster: pwindowsobject;ztitel: pchar);
  23. Procedure   sync;
  24. Procedure   getwindowclass(var awndclass:twndclass);virtual;
  25. Procedure   GetFreq(var msg:tmessage);virtual  wm_first+ wm_user;
  26. Procedure   display(strg:string);
  27. Function    canclose:boolean;virtual;
  28. Destructor  done;virtual;
  29. End; {tfenster}
  30.  
  31. Var MyApp:tmyapplication;
  32.  
  33. {------------------------------------------------------------------------}
  34.  
  35. Procedure tmyapplication.initmainwindow;
  36. Begin
  37. Mainwindow := new(pfenster, init(nil, 'wbild'));
  38. End;
  39.  
  40. Function tmyapplication.processappmsg(var message:tmsg):boolean;
  41. Begin
  42. If (message.message = wm_timer)then begin
  43. Sendmessage(mainwindow^.hwindow,wm_user,0,0);
  44. End;
  45. Processappmsg:=tapplication.processappmsg(message);
  46. End;
  47.  
  48. {------------------------------------------------------------------------}
  49.  
  50. Constructor tfenster.init(mutterfenster: pwindowsobject;ztitel: pchar);
  51. Var t   :word;
  52. Begin
  53. Twindow.init(mutterfenster,ztitel);
  54. { zeitgeber mit 2-sekundentakt setzen}
  55. If settimer(hwindow,1,3000,nil)=0 then
  56. Messagebox(hwindow,'fehler beim anlegen des zeitgebers','',mb_ok);
  57. For t:=0 to 9 do f[t]:=0;count:=0;
  58. Attr.w:=170;attr.h:=60;
  59. Str(getsystemmetrics(sm_cxscreen),xres);
  60. Str(getsystemmetrics(sm_cyscreen),yres);
  61. End;
  62.  
  63. Procedure tfenster.getwindowclass;
  64. Begin
  65. Inherited getwindowclass(awndclass);
  66. Awndclass.style:=awndclass.style or cs_dblclks;
  67. Awndclass.hicon:=0;                 { hiermit wird die Symbolanzeige aktiviert}
  68. End;
  69.  
  70. Procedure tfenster.sync; { Synchronisation mit vertikalem Kathodenstrahlrueckgang }
  71. Var m:tmsg;
  72. Begin
  73. Repeat until (port[$3da] and 8)=0;
  74. Repeat until (port[$3da] and 8)=8;
  75. {ankommende botschaften weiterleiten}
  76. If peekmessage(m,0,0,0,pm_remove) then begin
  77. Translatemessage(m); dispatchmessage(m);
  78. End;
  79. End;
  80.  
  81. Procedure tfenster.getfreq(var msg:tmessage);
  82. Const SyncCount = 100;
  83. Var 
  84. strg:string;
  85. h,h2,m,m2,s,s2,s100,s200,i:word;
  86. freq:real;
  87. Begin
  88. busy:=true;
  89. If f[1]=0 then display('wait');
  90. inc(count);
  91. Count:=count mod 10;
  92. sync;
  93. Gettime(h,m,s,s100);
  94. For i:=1 to synccount do sync;
  95. Gettime(h2,m2,s2,s200);
  96. f[count]:=synccount/(100*(h2*36+m2*0.6+s2/100+s200/10000-h*36-m*0.6-s/100-s100/10000));
  97. freq:=0;
  98. For i:=0 to 9 do freq:=freq+f[i];
  99. freq:=freq/10;
  100. Str(freq:3:2,strg);
  101. If not isiconic(hwindow) then display(xres+'*'+yres+'  v='+strg+'hz') else display(strg);
  102. busy:=false;
  103. End;
  104.  
  105. Procedure tfenster.display(strg:string);
  106. Var 
  107. AChar :array[0..255] of char;
  108. rect:trect;
  109. Begin
  110. Strpcopy(achar,strg);
  111. Wdc:=getdc(hwindow);
  112. Setbkcolor(wdc,rgb(0,170,0));                 {Hintergrundfarbe grⁿn}
  113. Settextalign(wdc,ta_center or ta_bottom);     {Text zentriert}
  114. With rect do begin
  115. left:=0; right:=attr.w; top:=0;  bottom:=attr.h;
  116. End;
  117. If isiconic(hwindow) then exttextout(wdc,18,25,eto_opaque,@rect,achar,strlen(achar),nil) else
  118. Begin
  119. Exttextout(wdc,attr.w div 2,attr.h div 2,eto_opaque,@rect,achar,strlen(achar),nil);
  120. End;
  121. Releasedc(hwindow,wdc);
  122. End;
  123.  
  124. Function tfenster.canclose:boolean;
  125. Var m:tmsg;
  126. Begin
  127. display('end');
  128. Canclose:=not busy;
  129. {wenn gerade eine Zeitmessung erfolgt die Botschaft wm_close aufschieben}
  130. m.message:=wm_close;
  131. If busy then dispatchmessage(m);
  132. End;
  133.  
  134. Destructor tfenster.done;
  135. Var 
  136. m:tmsg;
  137. ms:tmessage;
  138. Begin
  139. Killtimer(hwindow,1);                 {Zeitgeber entfernen}
  140. Twindow.done;
  141. End;
  142.  
  143. {------------------------------------------------------------------------}
  144.  
  145. Begin
  146. Myapp.init('');
  147. Myapp.run;
  148. Myapp.done;
  149. End.
  150.